perm filename MOD1.F4[JC1,MUS] blob
sn#007306 filedate 1972-07-04 generic text, type T, neo UTF8
00100 DIMENSION W1(512),FUNC(512),SU(1000)
00200 DO 1 I=1,1000
00300 1 SU(I)=0.0
00400 GO TO 43
00500 40 CALL HYDPOG(1)
00510 TYPE 31,A,FC,FM,XI
00515 31 FORMAT(4F/)
00600 43 TYPE 41
00700 41 FORMAT(' TYPE 1 FOR WITHOUT SIN ELSE 2'/)
00800 ACCEPT 42,JP
00900 42 FORMAT(I)
01000 60 TYPE 50
01100 50 FORMAT(' TYPE A,CF,MF,I'/)
01200 ACCEPT 100,A,FC,FM,XI
01300 100 FORMAT (4F)
01400 CALL TYPLOC(-300,-512)
01500 CALL DPYSET(1,SU,1000)
01600 CALL DPYBRT(1)
01700 CALL AIVECT(0,0)
01800 CALL ALINE(0,-12,0,12)
01900 CALL ALINE(256,-12,256,12)
02000 CALL ALINE(-268,128,-244,128)
02100 CALL ALINE(-268,256,-244,256)
02200 CALL ALINE(-268,-128,-244,-128)
02300 CALL ALINE(-268,-254,-244,-254)
02400 CALL ALINE(-264,0,256,0)
02500 CALL ALINE(-256,-256,-256,256)
02600 CALL DPYBRT(6)
02700 I=-1
02800 DO 200 J=1,513
02900 X=J-1
03000 Y=6.28319/512.
03100 IF(JP.EQ.1)GO TO 1000
03200 FUNC(J)=A*SIN((FC*X)*Y-(XI*(COS((FM*X)*Y)))+XI)
03300 IY2=FUNC(J)*256.
03400 GO TO 1002
03500 1000 FUNC(J)=(FC*X)*Y-XI*(COS((FM*X)*Y))+XI
03600 IY2=FUNC(J)*256./6.28319
03700 1002 IF(I.EQ.0)GO TO 150
03800 CALL AIVECT(-256,IY2)
03900 I=0
04000 GO TO 160
04100 150 CALL SVECT(1,IY2-IY)
04200 160 IY=IY2
04300 200 CONTINUE
04400 CALL DPYOUT(1)
04500 TYPE 401
04600 401 FORMAT(' 0 TO CHANGE ELSE N'/)
04700 ACCEPT 300,M
04800 300 FORMAT (I)
04900 IF(M.EQ.0)GO TO 40
05000 TYPE 501
05100 501 FORMAT(' 3 CHAR. FOR .DAT FILE'/)
05200 ACCEPT 502,V
05300 502 FORMAT(A3)
05400 CALL OFILE(1,V)
05500 WRITE(1)(SU(K),K=1,1000)
05600 END FILE 1
05700 GO TO 40
05800 END